home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / scsh / re.scm < prev    next >
Text File  |  1995-10-27  |  2KB  |  82 lines
  1. ;;; Regular expression matching for scsh
  2. ;;; Copyright (c) 1994 by Olin Shivers.
  3.  
  4. (foreign-source
  5.   "/* Make sure foreign-function stubs interface to the C funs correctly: */"
  6.   "#include \"re1.h\""
  7.   "" ""
  8.   )
  9.  
  10. (define-record regexp-match
  11.   string
  12.   start    ; 10 elt vec
  13.   end)  ; 10 elt vec
  14.  
  15. ;;; Need to do error case for these three procs.
  16.  
  17. (define (match:start match . maybe-index)
  18.   (vector-ref (regexp-match:start match)
  19.           (optional-arg maybe-index 0)))
  20.  
  21. (define (match:end match . maybe-index)
  22.   (vector-ref (regexp-match:end match)
  23.           (optional-arg maybe-index 0)))
  24.  
  25. (define (match:substring match . maybe-index)
  26.   (let ((i (optional-arg maybe-index 0)))
  27.     (substring (regexp-match:string match)
  28.            (match:start match i)
  29.            (match:end match i))))
  30.  
  31. (define (string-match pattern string . maybe-start)
  32.   (apply regexp-exec (make-regexp pattern) string maybe-start))
  33.  
  34.  
  35. ;;; Bogus stub definitions for low-level match routines:
  36.  
  37. (define regexp? string?)
  38. (define (make-regexp str) str)
  39.  
  40. (define (regexp-exec regexp str . maybe-start)
  41.   (let ((start (optional-arg maybe-start 0))
  42.     (start-vec (make-vector 10))
  43.     (end-vec (make-vector 10)))
  44.     (and (%regexp-match regexp str start start-vec end-vec)
  45.      (make-regexp-match str start-vec end-vec))))
  46.  
  47.  
  48. ;;; Convert a string into a regex pattern that matches that string exactly --
  49. ;;; in other words, quote the special chars with backslashes.
  50. (define (regexp-quote string)
  51.   (let lp ((i (- (string-length string) 1))
  52.        (result '()))
  53.     (if (< i 0) (list->string result)
  54.     (lp (- i 1)
  55.         (let* ((c (string-ref string i))
  56.            (result (cons c result)))
  57.           (if (memv c '(#\[ #\] #\. #\* #\? #\( #\) #\| #\\ #\$ #\^ #\+))
  58.           (cons #\\ result)
  59.           result))))))
  60.  
  61. (define-foreign %regexp-match/errno (reg_match (string regexp)
  62.                            (string s)
  63.                            (integer start)
  64.                            (vector-desc start-vec)
  65.                            (vector-desc end-vec))
  66.   static-string ; Error string or #f if all is ok.
  67.   bool)        ; match?
  68.  
  69. (define (%regexp-match regexp string start start-vec end-vec)
  70.   (receive (err match?) (%regexp-match/errno regexp string start
  71.                          start-vec end-vec)
  72.     (if err (error err %regexp-match regexp string start) match?)))
  73.  
  74.  
  75. ;;; I do this one in C, I'm not sure why:
  76. ;;; Used by MATCH-FILES.
  77.  
  78. (define-foreign %filter-C-strings!
  79.   (filter_stringvec (string regexp) ((C "char const ** ~a") cvec))
  80.   static-string    ; error message -- #f if no error.
  81.   integer)    ; number of files that pass the filter.
  82.